home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0127_Palette Fades-Transparent.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  15KB  |  454 lines
  1. Program Transparent;
  2. {                                       }
  3. {   Example of How Transparency Works   }
  4. {                                       }
  5. {  Programmed by David Dahl @ 1:272/38  }
  6. {                                       }
  7. {     This program is PUBLIC DOMAIN     }
  8. {                                       }
  9. Uses CRT, Palette;
  10.  
  11. Type ImageArray = Array [0..15, 0..15] of Byte;
  12.  
  13.      LocationRec = Record
  14.                          X : Integer;
  15.                          Y : Integer;
  16.                    End;
  17.  
  18.      VGABufferArray = Array[0..199, 0..319] of Byte;
  19.      VGABufferPtr   = ^VGABufferArray;
  20.  
  21. Const BobTemplate : ImageArray =
  22.               ((00,00,00,00,00,00,07,07,07,07,00,00,00,00,00,00),
  23.                (00,00,00,00,07,07,04,04,04,04,06,05,00,00,00,00),
  24.                (00,00,00,07,04,04,04,04,04,04,04,04,04,00,00,00),
  25.                (00,00,07,04,04,04,04,04,04,04,04,04,04,03,00,00),
  26.                (00,07,04,04,04,04,04,04,04,04,04,04,04,04,02,00),
  27.                (00,07,04,04,04,04,04,04,04,04,04,04,04,04,01,00),
  28.                (07,04,04,04,04,04,04,04,04,04,04,04,04,04,04,01),
  29.                (07,04,04,04,04,04,04,04,04,04,04,04,04,04,04,01),
  30.                (07,04,04,04,04,04,04,04,04,04,04,04,04,04,04,01),
  31.                (07,04,04,04,04,04,04,04,04,04,04,04,04,04,04,01),
  32.                (00,06,04,04,04,04,04,04,04,04,04,04,04,04,01,00),
  33.                (00,06,04,04,04,04,04,04,04,04,04,04,04,04,01,00),
  34.                (00,00,05,04,04,04,04,04,04,04,04,04,04,01,00,00),
  35.                (00,00,00,04,04,04,04,04,04,04,04,04,01,00,00,00),
  36.                (00,00,00,00,03,02,04,04,04,04,01,01,00,00,00,00),
  37.                (00,00,00,00,00,00,01,01,01,01,00,00,00,00,00,00));
  38.  
  39.       MaxBob = 2; { 3 Bobs (0 .. 2) }
  40.  
  41. Var VGA        : VGABufferPtr;
  42.     BackGround : VGABufferPtr;
  43.     WorkPage   : VGABufferPtr;
  44.  
  45.     Pal : PaletteArray;
  46.  
  47.     BobImage    : Array[0..MaxBob] of ImageArray;
  48.     BobLocation : Array[0..MaxBob] of LocationRec;
  49.  
  50.     Counter1 : Integer;
  51.     Counter2 : Integer;
  52.  
  53. {-[ Set VGA Mode 13h (320 X 200 X 256 Chain 4) ]------------------------}
  54. Procedure SetMode13h; Assembler;
  55. ASM
  56.    MOV AX, $13
  57.    INT $10
  58. End;
  59. {-[ Put A 16 X 16 Image by ORing it With Background ]-------------------}
  60. Procedure Put16X16ImageOR (Var Bob    : ImageArray;
  61.                                X, Y   : Integer);
  62. Var CounterX,
  63.     CounterY  : Integer;
  64. Begin
  65.      For CounterY := 0 to 15 do
  66.       For CounterX := 0 to 15 do
  67.        WorkPage^[CounterY + Y, CounterX + X] :=
  68.         WorkPage^[CounterY + Y, CounterX + X] OR Bob[CounterX, CounterY];
  69. End;
  70. {-[ Update Bob Positions ]----------------------------------------------}
  71. Procedure UpdateBobs;
  72. Var BobCounter : Integer;
  73. Begin
  74.      For BobCounter := 0 to MaxBob do
  75.      Begin
  76.           Inc (Counter1, 1);
  77.           While (Counter1 >= 360) do
  78.              Dec(Counter1, 360);
  79.  
  80.           If (Counter1 MOD 2) = 0
  81.           Then
  82.           Begin
  83.                Inc(Counter2,1);
  84.                While (Counter2 >= 360) do
  85.                      Dec(Counter2, 360);
  86.           End;
  87.  
  88.           BobLocation[BobCounter].X := 160 +
  89.              Round(90 * -Sin((Counter1 + (BobCounter*Counter2))*PI/180));
  90.  
  91.           BobLocation[BobCounter].Y := 95 +
  92.              Round(60 * Cos((Counter2 + (BobCounter*Counter1))*PI/180));
  93.  
  94.      End;
  95. End;
  96. {-[ Draw All Bobs To Work Buffer ]--------------------------------------}
  97. Procedure DrawBobs;
  98. Var BobCounter : Integer;
  99. Begin
  100.      For BobCounter := 0 to MaxBob do
  101.          Put16X16ImageOR (BobImage[BobCounter],
  102.             BobLocation[BobCounter].X, BobLocation[BobCounter].Y);
  103. End;
  104. {-[ Initialize Variables ]----------------------------------------------}
  105. Procedure InitializeVariables;
  106. Const Tbl : Array [0..MaxBob] of Byte = (8, 16, 32);
  107. Var BobCounter : Integer;
  108.     CX, CY     : Integer;
  109. Begin
  110.      { Make Individual Bobs From Template }
  111.      For BobCounter := 0 to MaxBob do
  112.      Begin
  113.           BobImage[BobCounter] := BobTemplate;
  114.  
  115.           For CY := 0 to 15 do
  116.               For CX := 0 to 15 do
  117.                   If BobImage[BobCounter][CX,CY] <> 0
  118.                   Then
  119.                       BobImage[BobCounter][CX,CY] :=
  120.                          BobImage[BobCounter][CX,CY] OR Tbl[BobCounter];
  121.      End;
  122.  
  123.      Counter1 := 0;
  124.      Counter2 := 0;
  125. End;
  126. {-[ Build Palette ]-----------------------------------------------------}
  127. Procedure BuildPalette;
  128. Var ColorCounter : Integer;
  129. Begin
  130.      { Initialize Palette Buffer To All Black }
  131.      FillChar (Pal, SizeOf(Pal), 0);
  132.  
  133.      For ColorCounter := 0 to 7 do
  134.      Begin
  135.       { Make Red, Green, and Blue Bobs }
  136.       Pal[ColorCounter OR 08].Red   := 21 + (ColorCounter * 6);
  137.       Pal[ColorCounter OR 16].Green := 21 + (ColorCounter * 6);
  138.       Pal[ColorCounter OR 32].Blue  := 21 + (ColorCounter * 6);
  139.  
  140.       { Make Colors Where Red and Green Bobs Overlap }
  141.       Pal[ColorCounter OR 08 OR 16].Red   := 21 + (ColorCounter * 6);
  142.       Pal[ColorCounter OR 08 OR 16].Green := 21 + (ColorCounter * 6);
  143.  
  144.       { Make Colors Where Red and Blue Bobs Overlap }
  145.       Pal[ColorCounter OR 08 OR 32].Red  := 21 + (ColorCounter * 6);
  146.       Pal[ColorCounter OR 08 OR 32].Blue := 21 + (ColorCounter * 6);
  147.  
  148.       { Make Colors Where Green and Blue Bobs Overlap }
  149.       Pal[ColorCounter OR 16 OR 32].Green := 21 + (ColorCounter * 6);
  150.       Pal[ColorCounter OR 16 OR 32].Blue  := 21 + (ColorCounter * 6);
  151.  
  152.       { Make Colors Where Red, Green and Blue Bobs Overlap }
  153.       Pal[ColorCounter OR 08 OR 16 OR 32].Red   := 21+(ColorCounter * 6);
  154.       Pal[ColorCounter OR 08 OR 16 OR 32].Green := 21+(ColorCounter * 6);
  155.       Pal[ColorCounter OR 08 OR 16 OR 32].blue  := 21+(ColorCounter * 6);
  156.      End;
  157.  
  158.      { Make Colors Where The Grey Square Overlaps The Bobs }
  159.      For ColorCounter := 128 to 255 do
  160.      Begin
  161.       Pal[ColorCounter].Red   := (Pal[ColorCounter-128].Red   DIV 4)+14;
  162.       Pal[ColorCounter].Green := (Pal[ColorCounter-128].Green DIV 4)+14;
  163.       Pal[ColorCounter].Blue  := (Pal[ColorCounter-128].Blue  DIV 4)+14;
  164.      End;
  165. End;
  166. {-[ Draw Grey Square In Background Buffer ]-----------------------------}
  167. Procedure BuildBackground;
  168. Var Y, X : Integer;
  169. Begin
  170.      FillChar (BackGround^, SizeOf(BackGround^), 0);
  171.  
  172.      For Y := 50 to 150 do
  173.      For X := 100 to 220 do
  174.          BackGround^[Y, X] := 128;
  175.  
  176. End;
  177. {=[ Main Program ]======================================================}
  178. Begin
  179.      VGA := Ptr ($A000,$0000);
  180.      New (WorkPage);
  181.      New (BackGround);
  182.  
  183.      InitializeVariables;
  184.      BuildPalette;
  185.      BuildBackground;
  186.  
  187.      SetMode13h;
  188.      SetPalette (Pal);
  189.  
  190.      Repeat
  191.            UpdateBobs;               { Update Bob Positions }
  192.            WorkPage^ := BackGround^; { Clear WorkPage With Static Image }
  193.            DrawBobs;                 { Draw Bobs }
  194.  
  195.            { Wait For Retrace }
  196.            Repeat Until ((Port[$3DA] AND 8) <> 0);
  197.  
  198.            VGA^ := WorkPage^;        { Display Page }
  199.      Until KeyPressed;
  200.  
  201.      TextMode (C80);
  202.  
  203.      Dispose (BackGround);
  204.      Dispose (WorkPage);
  205. End.
  206.  
  207. { PALETTE CODE FOLLOWS }
  208.  
  209. {
  210.  TD> I've seen it done in many places, but I haven't seen any info on
  211.  TD> how it's done:  What is the basic algorithm for fading from one
  212.  TD> palette to another.
  213.  
  214.         Many people do palette fading incorrectly.  The correct
  215. way to do it would be to set up a relation such as:
  216.  
  217.         Palette_Element     Calculated_Element
  218.         ---------------  =  ------------------
  219.          Max_Intensity      Current_Intensity
  220.  
  221. Where Palette_Element is a single element in our master DAC
  222. table, Max_Intensity is the maximum allowable intensity level for
  223. our scale, Current_Intensity is a number between 0 and
  224. Max_Intensity which represents the level we want, and
  225. Calculated_Element is the new value for the element of our DAC
  226. table.  But since we want the Calculated_Element, we re-write it
  227. as this equation:
  228.  
  229.         Calculated_Element = Palette_Element * Current_Intensity
  230.                              -----------------------------------
  231.                                          Max_Intensity
  232.  
  233. The above equation will allow us to fade a given palette set to
  234. black or from black to a given palette set.  To fade out an entire
  235. palette set, you would need to calculate the above for the red,
  236. green, and blue components of each color in the 256 element DAC
  237. table.
  238.         Fading from one palette set to another palette set is
  239. very similar.  What you must do is fade one palette set to black
  240. while simultaneously fade from black to another palette set and
  241. add the two values.  The equation for this is:
  242.  
  243.        CE = ((PE1 * (MI - CI)) + (PE2 * CI)) / MI
  244.  
  245. Where CE is the calculated element, PE1 and PE2 are corresponding
  246. palette elements from palette 1 and 2, MI is the maximum
  247. intensity in our scale, and CI is the current intensity we want
  248. (num between 0 and MI). }
  249.  
  250. Unit Palette;
  251. { Programmed By David Dahl @ FidoNet 1:272/38 }
  252. (* PUBLIC DOMAIN *)
  253. Interface
  254.   Type PaletteRec = Record
  255.                           Red   : Byte;
  256.                           Green : Byte;
  257.                           Blue  : Byte;
  258.                     End;
  259.        PaletteArray = Array [0..255] of PaletteRec;
  260.  
  261.   Procedure SetPalette (Var PaletteIn : PaletteArray);
  262.   Procedure FadeFromPaletteToBlack (Var PaletteIn : PaletteArray);
  263.   Procedure FadeFromBlackToPalette (Var PaletteIn : PaletteArray);
  264.   Procedure FadeFromPalette1ToPalette2 (Var Palette1 : PaletteArray;
  265.                                         Var Palette2 : PaletteArray);
  266. Implementation
  267. Procedure SetPalette (Var PaletteIn : PaletteArray); Assembler;
  268. Asm
  269.    { Get Address of PaletteIn }
  270.    LDS SI, PaletteIn
  271.    CLD
  272.  
  273.    { Tell VGA To Start With First Palette Element }
  274.    XOR AX, AX     
  275.    MOV DX, $3C8
  276.    OUT DX, AL
  277.  
  278.    { Wait For Retrace }
  279.    MOV DX, $3DA
  280.    @VRWait1:
  281.      IN AL, DX
  282.      AND AL, 8
  283.    JZ @VRWait1
  284.    
  285.    { Set First Half Of Palette }
  286.    MOV DX, $3C9
  287.    MOV CX, 128 * 3
  288.    @PALLOOP1:
  289.      LODSB  { DON'T use "REP OUTSB" since some VGA cards can't handle it }
  290.      OUT DX, AL
  291.    LOOP @PALLOOP1
  292.  
  293.    { Wait For Retrace }
  294.    PUSH DX
  295.    MOV DX, $3DA
  296.    @VRWait2:
  297.      IN AL, DX
  298.      AND AL, 8
  299.    JZ @VRWait2
  300.    POP DX
  301.  
  302.    { Set Last Half Of Palette }
  303.    MOV CX, 128 * 3
  304.    @PALLOOP2:
  305.      LODSB
  306.      OUT DX, AL
  307.    LOOP @PALLOOP2
  308. End;
  309.  
  310. Procedure FadeFromPaletteToBlack (Var PaletteIn : PaletteArray);
  311. Var WorkPalette : PaletteArray;
  312.     Counter     : Integer;
  313.     Intensity   : Integer;
  314. Begin
  315.      For Intensity := 31 downto 0 do  
  316.      Begin
  317.        For Counter := 0 to 255 do
  318.        Begin
  319.           WorkPalette[Counter].Red   := 
  320.                    (PaletteIn[Counter].Red   * Intensity) DIV 32;
  321.           WorkPalette[Counter].Green := 
  322.                    (PaletteIn[Counter].Green * Intensity) DIV 32;
  323.           WorkPalette[Counter].Blue  := 
  324.                    (PaletteIn[Counter].Blue  * Intensity) DIV 32;
  325.        End;
  326.        SetPalette (WorkPalette);
  327.      End;
  328. End;
  329.  
  330. Procedure FadeFromBlackToPalette (Var PaletteIn : PaletteArray);
  331. Var WorkPalette : PaletteArray;
  332.     Counter     : Integer;
  333.     Intensity   : Integer;
  334. Begin
  335.      For Intensity := 1 to 32 do  
  336.      Begin
  337.        For Counter := 0 to 255 do
  338.        Begin
  339.           WorkPalette[Counter].Red   := 
  340.                    (PaletteIn[Counter].Red   * Intensity) DIV 32;
  341.           WorkPalette[Counter].Green := 
  342.                    (PaletteIn[Counter].Green * Intensity) DIV 32;
  343.           WorkPalette[Counter].Blue  := 
  344.                    (PaletteIn[Counter].Blue  * Intensity) DIV 32;
  345.        End;
  346.        SetPalette (WorkPalette);
  347.      End;
  348. End;
  349.  
  350. Procedure FadeFromPalette1ToPalette2 (Var Palette1 : PaletteArray;
  351.                                       Var Palette2 : PaletteArray);
  352. Var WorkPalette : PaletteArray;
  353.     Counter     : Integer;
  354.     CrossFade   : Integer;
  355. Begin
  356.      For CrossFade := 0 to 32 do
  357.      Begin
  358.        For Counter := 0 to 255 do
  359.        Begin
  360.          WorkPalette[Counter].Red   :=
  361.              ((Palette1[Counter].Red   * (32 - CrossFade)) + 
  362.               (Palette2[Counter].Red   * CrossFade)) DIV 32;
  363.          WorkPalette[Counter].Green :=
  364.              ((Palette1[Counter].Green * (32 - CrossFade)) + 
  365.               (Palette2[Counter].Green * CrossFade)) DIV 32;
  366.          WorkPalette[Counter].Blue  :=
  367.              ((Palette1[Counter].Blue  * (32 - CrossFade)) + 
  368.               (Palette2[Counter].Blue  * CrossFade)) DIV 32;
  369.        End;
  370.        SetPalette (WorkPalette);
  371.      End;
  372. End;
  373. End.
  374.  
  375. TUTORIAL !!
  376.  
  377.         Transparent objects are rather simple.  What you do is
  378. set up your palette so pure colors are represented by powers of
  379. two.  This way you can "mix" your colors by ORing the values
  380. together.  For simplicity's sake, this example will use 3 colors:
  381.  
  382.         Bit  7 6 5 4 3 2 1 0
  383.                        | | |
  384.                        | | +----> Red
  385.                        | +------> Green
  386.                        +--------> Blue
  387.  
  388. So now you would set your palette up as follows:
  389.  
  390.     All single colors:
  391.  
  392.       2^0 = 1   --   Red
  393.       2^1 = 2   --   Green
  394.       2^2 = 4   --   Blue
  395.  
  396.     All possible 2 color mixes:
  397.  
  398.       2^0 OR 2^1 = 1 OR 2 = 3   --   Red + Green  = Yellow
  399.       2^0 OR 2^2 = 1 OR 4 = 5   --   Red + Blue   = Magenta
  400.       2^1 OR 2^2 = 2 OR 4 = 6   --   Green + Blue = Cyan
  401.  
  402.     All possible 3 color mixes:
  403.  
  404.       2^0 OR 2^1 OR 2^2 = 1 OR 2 OR 4 = 7  --  R + G + B = White
  405.  
  406. So our palette is set up as:
  407.  
  408.         0 - Black
  409.         1 - Red
  410.         2 - Green
  411.         3 - Yellow
  412.         4 - Blue
  413.         5 - Magenta
  414.         6 - Cyan
  415.         7 - White
  416.  
  417. Now let's say we have a Red, Green, and a Blue square.  The
  418. bitmap of the red square will be made up of bytes of the value 1,
  419. the green square will be made up of the value 2, and the blue
  420. square will be made up of the value 4 as so:
  421.  
  422.            Red             Green              Blue
  423.  
  424.          11111111         22222222          44444444
  425.          11111111         22222222          44444444
  426.          11111111         22222222          44444444
  427.          11111111         22222222          44444444
  428.  
  429. To put the squares, you just have to OR put them to your frame
  430. buffer.  If they overlap, they will automatically mix as so:
  431.  
  432.      The 3 overlaping bitmaps       The 3 overlaping bitmaps
  433.      in frame buffer using an       in frame buffer showing
  434.      OR'd image put:                what colors are where:
  435.  
  436.             11111111                      RRRRRRRR
  437.             11111111                      RRRRRRRR
  438.             111133332222                  RRRRYYYYGGGG
  439.             155577776222                  RMMMWWWWCGGG
  440.              44466666222                   BBBCCCCCGGG
  441.              44466666222                   BBBCCCCCGGG
  442.              44444444                      BBBBBBBB
  443.  
  444. The following example program uses this bit scheme:
  445.  
  446.         Bit  7 6 5 4 3 2 1 0
  447.              |   | | | +-+-+---> Color Intensity (0:Least - 7:Full)
  448.              |   | | +---------> Red
  449.              |   | +-----------> Green
  450.              |   +-------------> Blue
  451.              +-----------------> Grey
  452.  
  453.  
  454. David Dahl